home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Decision Cube / MXPBAR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  4.2 KB  |  171 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1997,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit mxpbar;
  10.  
  11. { the progress dialog with a cancel button }
  12.  
  13. interface
  14.  
  15. uses
  16.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  17.   StdCtrls, ComCtrls;
  18.  
  19. type
  20.   EUserCanceled = class(Exception);
  21.  
  22.   TProgressDialog = class(TForm)
  23.     ProgressBar: TProgressBar;
  24.     CancelButton: TButton;
  25.     StatusText: TStaticText;
  26.     procedure CancelButtonClick(Sender: TObject);
  27.     procedure FormActivate(Sender: TObject);
  28.     procedure FormCreate(Sender: TObject);
  29.   private
  30.     FCanceled: Boolean;
  31.     FInterval: Integer;
  32.     FCount: Integer;
  33.     FRealMax: Integer;
  34.     FBuilding: Boolean;
  35.     BuildDone: Boolean;
  36.     FExceptMessage: string;
  37.     FOnPerformBuild: TNotifyEvent;
  38.     function GetMax: Integer;
  39.     procedure SetMax(Value: Integer);
  40.     procedure SetInterval(Value: Integer);
  41.     procedure StartBuild(var Message); message WM_USER;
  42.   public
  43.     function StepProgress: Boolean;
  44.     procedure ShowStatus(Msg: string);
  45.     function UpdateProgress: Integer;
  46.     procedure Reset;
  47.     property Max: Integer read GetMax write SetMax;
  48.     property Canceled: Boolean read FCanceled write FCanceled;
  49.     property Interval: Integer read FInterval write SetInterval;
  50.     property OnPerformBuild: TNotifyEvent read FOnPerformBuild write FOnPerformBuild;
  51.     property ExceptMessage: string read FExceptMessage write FExceptMessage;
  52.   end;
  53.  
  54. var
  55.   ProgressDlg: TProgressDialog = nil;
  56.  
  57. implementation
  58.  
  59. {$R *.DFM}
  60.  
  61. procedure TProgressDialog.StartBuild(var Message);
  62. begin
  63.   try
  64.     FBuilding := True;
  65.     if Assigned(FOnPerformBuild) then
  66.     begin
  67.       try
  68.         FOnPerformBuild(Self);
  69.       except
  70.         FExceptMessage := Exception(ExceptObject).Message;
  71.         ModalResult := mrAbort;
  72.       end;
  73.       ModalResult := mrCancel;
  74.     end;
  75.   finally
  76.     Self.Visible := False;
  77.     BuildDone := True;
  78.     FBuilding := False;
  79.     Canceled := True;
  80.   end;
  81. end;
  82.  
  83. function TProgressDialog.UpdateProgress: Integer;
  84. begin
  85.   StepProgress;
  86.   Application.ProcessMessages;
  87.   if Canceled then
  88.     Result := -1
  89.   else
  90.     Result := 0;
  91. end;
  92.  
  93. function TProgressDialog.GetMax: Integer;
  94. begin
  95.   Result := FRealMax;
  96. end;
  97.  
  98. procedure TProgressDialog.SetMax(Value: Integer);
  99. begin
  100.   if (Value <> FRealMax) then
  101.   begin
  102.     FRealMax := Value;
  103.     ProgressBar.Max := Value;
  104.     ProgressBar.Position := 1;
  105.     if (Value > 10000) then
  106.       Interval := Integer(Trunc(Value * 0.05))
  107.     else if (Value > 100) then
  108.       Interval := Integer(Trunc(Value * 0.10))
  109.     else
  110.       Interval := 1;
  111.   end;
  112. end;
  113.  
  114. function TProgressDialog.StepProgress: Boolean;
  115. begin
  116.   Result := False;
  117.   if (FCount = FInterval) and (ProgressBar.Max > 0) then
  118.   begin
  119.     if not Visible then Visible := True;
  120.     ProgressBar.StepIt;
  121.     FCount := 0;
  122.     Result := True;
  123.   end;
  124.   Inc(FCount);
  125. end;
  126.  
  127. procedure TProgressDialog.ShowStatus(Msg: string);
  128. begin
  129.   if (StatusText.Visible = False) then
  130.     StatusText.Visible := True;
  131.   StatusText.Caption := msg;
  132. end;
  133.  
  134. procedure TProgressDialog.CancelButtonClick(Sender: TObject);
  135. begin
  136.   Canceled := True;
  137.   if BuildDone and (CancelButton.ModalResult <> mrOK) then
  138.     ModalResult := mrCancel;
  139. end;
  140.  
  141. procedure TProgressDialog.SetInterval(Value: Integer);
  142. begin
  143.   if (Value <> FInterval) then
  144.   begin
  145.     { set the new max based on the interval }
  146.     FInterval := Value;
  147.     FCount := 1;
  148.     ProgressBar.Step := Value;
  149.   end;
  150. end;
  151.  
  152. procedure TProgressDialog.Reset;
  153. begin
  154.   ProgressBar.Position := 1;
  155. end;
  156.  
  157. procedure TProgressDialog.FormActivate(Sender: TObject);
  158. begin
  159.   if not FBuilding then
  160.     PostMessage(Handle, WM_USER, 0, 0);
  161. end;
  162.  
  163. procedure TProgressDialog.FormCreate(Sender: TObject);
  164. begin
  165.   SetBounds((Screen.Width - Width) div 2,
  166.            (GetSystemMetrics(SM_CYSCREEN) - Height) div 3,
  167.            Width, Height);
  168. end;
  169.  
  170. end.
  171.